perm filename DOTS[1,VDS] blob
sn#010375 filedate 1972-08-27 generic text, type T, neo UTF8
00100 %DOTS PROGRAM---VERSION 2---AUGUST 19,1972
00200 PROGRAM WRITTEN BY ARTHUR FLEXSER FOR CS 206 TERM PROJECT%
00300 BEGIN
00400 % THE COMMAND 'CMD' CAN BE USED AFTER THE MACHINE TYPES
00500 'YOUR MOVE' IN ORDER TO GET YOU TO WHAT LOOKS LIKE THE
00600 TOP LEVEL OF LISP. YOU CAN GET OUT OF THIS MODE,
00700 AND BACK TO THE GAME, BY TYPING 'PLAY'. DON'T
00800 TYPE '(MEVAL)', OR 'PLAY' WON'T WORK WHEN YOU WANT
00900 TO GET BACK. AMONG THE INTERESTING THINGS TO LOOK
01000 AT ARE '(MASTVAL)', '(SQRSVAL)', 'BLOCKVALS', 'NSAF',
01100 AND ELEMENTS OF THE ARRAY 'BLOCKS'. %
01200 NEW ANSWER,LMOV,I,J,G,M1,M2,MOVE,MMOV,ST,BLIND;
01300 SPECIAL N,NSQ,NSAF,NLIN,NSQRS,LINES,BLOCKIND,BLOCKVALS,
01400 LLIST,LVAL,MSCORE,PSCORE,COMM,EX;
01500 SPECIAL NLEFT,VALUE,TM,TALIST;
01600 BLOCKIND←1;
01700 BLOCKVALS←NIL;
01800 MSCORE←PSCORE←0;
01900 LLIST←TALIST←NIL;
02000 VALUE←LVAL←0;
02100 TERPRI NIL; TERPRI NIL;
02200 PRINTSTR "THE GAME OF DOTS";
02300 PRINTSTR "DO YOU WANT INSTRUCTIONS?";
02400 QUES; ANSWER←READ ();
02500 IF ANSWER = 'YES OR ANSWER = 'Y THEN GO INSTR
02600 ELSE IF ANSWER = 'NO OR ANSWER = 'N
02700 THEN GO GAME
02800 ELSE PRINTSTR "YES OR NO?";
02900 GO QUES;
03000 INSTR; PRINTSTR
03100 " PLAYERS ALTERNATE IN CONNECTING HORIZONTALLY OR VERTICALLY
03200 ADJACENT DOTS IN A SQUARE ARRAY. IF A PLAYER COMPLETES
03300 A SQUARE, HE SCORES A POINT AND GOES AGAIN. PLAY CONTINUES
03400 UNTIL THE ARRAY IS COMPLETELY FILLED, AND THE PLAYER WITH
03500 THE HIGHEST SCORE WINS.
03600 ENTER YOUR MOVES IN THE FORM '(23 27)' TO STAND FOR
03700 A LINE JOINING DOT 23 TO DOT 27 ON THE BOARD WHICH I WILL
03800 PRINT OUT IN A MOMENT. THE SMALLER NUMBER MUST APPEAR FIRST.
03900 WHEN THE QUESTION 'YOUR MOVE?' APPEARS, YOU MAY IF
04000 YOU WISH OBTAIN THE CURRENT BOARD POSITION BY TYPING 'BD',
04100 OR THE CURRENT SCORE BY TYPING 'SCORE'.";
04200 TERPRI NIL; TERPRI NIL;
04300 GAME; PRINTSTR"NUMBER OF DOTS ON A SIDE?";
04400 N←READ();
04500 IF NOT NUMBERP N OR N LEQUAL 1 THEN GO GAME;
04600 IF N GREATERP 10 THEN PRINTSTR
04700 "THAT'S TOO MANY--MAXIMUM OF 10" ALSO GO GAME;
04800 NSQ←N*N;
04900 NLEFT←NLIN←NSAF←2*N*(N-1);
05000 NSQRS←(N-1)*(N-1);
05100 ARRAY(MAST,T,'(1 . 180));
05200 ARRAY(SQRS,5,'(1 . 81));
05300 ARRAY(BLOCKS,T,'(1 . 100));
05400 LINES←LINELIST();
05500 PRINTSTR "OK. HERE'S THE BOARD--RIP IT OFF AND USE IT,";
05600 PRINTSTR "IF YOU'RE AT A TELETYPE.";
05700 TERPRI(NIL);TERPRI(NIL);TERPRI(NIL);TERPRI(NIL);
05800 PRINBD();
05900 TERPRI(NIL);TERPRI(NIL);TERPRI(NIL);TERPRI(NIL);
06000 FOR NEW I←1 TO NLIN DO MAST (I)←'SA;
06100 FOR NEW I←1 TO NSQRS DO SQRS(I)←0;
06200 QUES2; PRINTSTR"DO YOU WANT TO MOVE FIRST?";
06300 ANSWER←READ();
06400 IF ANSWER='NO OR ANSWER='N THEN GO MACH
06500 ELSE IF ANSWER='YES OR ANSWER='Y THEN GO MOV
06600 ELSE GO QUES2;
06700 MOV; IF NLEFT=0 THEN GO CONCL ELSE PRINTSTR "YOUR MOVE?";
06800 LMOV←READ();
06900 IF LMOV='CMD THEN GO COMMAND
07000 ELSE IF LMOV='BD THEN PROG2(PRINTBD(),GO MOV)
07100 ELSE IF LMOV='SCORE THEN PRINTSTR ("MACHINE " CAT MSCORE
07200 CAT ", PLAYER " CAT PSCORE) ALSO GO MOV
07300 ELSE IF ATOM LMOV THEN PRINTSTR "INPUT ERROR"
07400 ALSO GO MOV
07500 ELSE (M1←CAR LMOV) ALSO (M2←CADR LMOV);
07600 IF NOT NUMBERP M1 OR NOT NUMBERP M2 THEN PRINTSTR
07700 "INPUT ERROR" ALSO GO MOV
07800 ELSE IF M1 LEQUAL 0 OR M2 LEQUAL 0 OR M1 GREATERP
07900 NSQ OR M2 GREATERP NSQ THEN PRINTSTR
08000 "ILLEGAL MOVE" ALSO GO MOV
08100 ELSE IF (TM←TMOV(M1,M2))='ERR THEN PRINTSTR"ILLEGAL MOVE"
08200 ALSO GO MOV
08300 ELSE MOVE←TM;
08400 ST←STATLIN(MOVE);
08500 IF ST='TA THEN PRINTSTR"TAKEN" ALSO GO MOV
08600 ELSE IF ST='SA THEN UPDATE(MOVE) ALSO GO MACH
08700 ELSE IF NULL LLIST THEN UPDATE(MOVE) ALSO
08800 BEGIN
08900 IF STATLIN(MOVE) NEQUAL 'TA THEN ST←STATLIN(MOVE) ALSO
09000 SETMAST(MOVE,'TA) ALSO TAKABLOCK(MOVE,ST)
09100 %THIS CAN HAPPEN IF IN THE PROCESS OF UPDATING MOVE, THE
09200 BLOCK YOU WERE TAKING WAS RE-FORMED%
09300 ELSE TAKABLOCK(MOVE,ST)
09400 END ALSO GO MOV
09500 ELSE IF NOT MEMBER(MOVE,LLIST) THEN
09600 BEGIN NEW H;
09700 BLIND←STATLIN(MOVE);
09800 H←HOOK(LLIST);
09900 LLIST←SUFLIST(LLIST,H-1) @ REVERSE PRELIST(LLIST,H-1);
10000 UPDATE(MOVE);
10100 FOR NEW I IN LLIST DO UPDATE(I);
10200 MMOV←(LLIST @ TAKBL(MOVE,BLIND));
10300 LLIST←NIL;
10400 MSCORE←MSCORE+LVAL;
10500 IF NLEFT NEQUAL 0 THEN MMOV←MMOV @ <GIVBL()>;
10600 TAKALIST(MMOV);
10700 MSCORE←MSCORE+VALUE;
10800 END ALSO GO MOV
10900 ELSE IF (G←GRABIT(MOVE)) NEQUAL 0 THEN
11000 BEGIN
11100 LLIST←LOPOFF(MOVE,LLIST);
11200 LVAL←LVAL-1;
11300 PSCORE←PSCORE+G;
11400 PRINTSTR ("SCORE " CAT G);
11500 UPDATE(MOVE);
11600 END ALSO GO MOV
11700 ELSE
11800 BEGIN NEW H;
11900 LLIST←LOPOFF(MOVE,LLIST);
12000 H←HOOK(LLIST);
12100 UPDATE(MOVE);
12200 MMOV←SUFLIST(LLIST,H-1) @ REVERSE PRELIST(LLIST,H-1);
12300 FOR NEW I IN MMOV DO UPDATE(I);
12400 LLIST←NIL;
12500 MSCORE←MSCORE+LVAL;
12600 IF NLEFT NEQUAL 0 THEN MMOV←MMOV @ <GIVBL()>;
12700 TAKALIST(MMOV);
12800 END ALSO GO MOV;
12900 MACH; IF NSAF GREATERP 0 THEN TAKASAFE() ALSO GO MOV
13000 ELSE GIVEABLOCK() ALSO GO MOV;
13100 COMMAND;COMM←READ();
13200 IF COMM='PLAY THEN GO MOV
13300 ELSE PROG2(EX←ERRSET(EVAL(COMM),T),
13400 IF NOT ATOM EX THEN
13500 PROG2(PRINT CAR EX,TERPRI NIL,GO COMMAND)
13600 ELSE PROG2(TERPRI NIL,GO COMMAND));
13700 CONCL; IF PSCORE GREATERP MSCORE THEN
13800 BEGIN
13900 TERPRI NIL; TERPRI NIL;
14000 PRINTSTR("CONGRATULATIONS--YOU WIN BY A SCORE OF "
14100 CAT PSCORE CAT " TO " CAT MSCORE CAT ".");
14200 PRINTSTR "FLESH AND BLOOD TRIUMPHS AGAIN OVER COLD STEEL!";
14300 TERPRI NIL; TERPRI NIL;
14400 END ALSO GO EN
14500 ELSE IF MSCORE GREATERP PSCORE THEN
14600 BEGIN
14700 TERPRI NIL; TERPRI NIL;
14800 PRINTSTR ("YOU LOSE BY A SCORE OF " CAT MSCORE
14900 CAT " TO " CAT PSCORE CAT ".");
15000 PRINTSTR"BETTER LUCK NEXT TIME, BUT YOU SHOULD HAVE KNOWN";
15100 PRINTSTR"BETTER THAN TO TRY TO OUTWIT ONE OF TODAY'S";
15200 PRINTSTR"MODERN SUPERMACHINES!";
15300 TERPRI NIL; TERPRI NIL;
15400 END ALSO GO EN
15500 ELSE
15600 BEGIN
15700 TERPRI NIL; TERPRI NIL;
15800 PRINTSTR("THE GAME IS A TIE-- " CAT MSCORE CAT
15900 " TO " CAT PSCORE CAT ".");
16000 PRINTSTR "YOU PUT UP A GOOD FIGHT.";
16100 TERPRI NIL; TERPRI NIL;
16200 END;
16300 EN; RETURN "";
16400 EXPR TMOV(V1,V2);
16500 IF V2 NEQUAL V1+1 AND V2 NEQUAL V1+N THEN 'ERR
16600 ELSE IF N*(V1/N)=V1 AND V2=V1+1 THEN 'ERR
16700 ELSE IF V2=V1+1 THEN <V1,1>
16800 ELSE <V1,2>;
16900 EXPR PRINLIN (I,J,STG,SP1,SP2);
17000 IF J=I+1 THEN STG
17100 ELSE IF J GEQUAL 10 THEN "." CAT J CAT SP2 CAT
17200 PRINLIN(I,J+1,STG,SP1,SP2)
17300 ELSE "." CAT J CAT SP1 CAT PRINLIN(I,J+1,STG,SP1,SP2);
17400 EXPR PRINBD();
17500 BEGIN NEW I,J;
17600 FOR I←1 TO N
17700 DO PRINTSTR(" " CAT PRINLIN
17800 (N*I,N*(I-1)+1,""," "," "))
17900 AND FOR J←1 TO 2 DO TERPRI(NIL);
18000 END;
18100 EXPR NBRS(LIN);NB(CAR LIN,CADR LIN);
18200 EXPR NB(V1,S);
18300 IF S=1 THEN
18400 IF V1 LEQUAL N THEN <V1>
18500 ELSE IF V1 GREATERP NSQ-N THEN <V1-N>
18600 ELSE <V1-N,V1>
18700 ELSE IF N*((V1-1)/N)=V1-1 THEN <V1>
18800 ELSE IF N*(V1/N)=V1 THEN <V1-1>
18900 ELSE <V1-1,V1>;
19000 EXPR LINELIST();
19100 BEGIN NEW V1,S,VAL,TERM;
19200 FOR V1←NSQ TO 1 BY -1 DO FOR S←2 TO 1 BY -1
19300 DO (TERM←<V1,S>) AND
19400 IF NOT (V1 GREATERP NSQ-N AND S=2) AND
19500 NOT (N*(V1/N)=V1 AND S=1) THEN
19600 VAL←TERM CONS VAL;
19700 RETURN VAL;
19800 END;
19900 EXPR IND(LIN);IND1(CAR LIN, CADR LIN);
20000 EXPR IND1(V1,S);
20100 IF V1 LEQUAL NSQ-N THEN 2*(V1-1)+S-(V1/N)
20200 ELSE V1-1+NSQ-N+S-(V1/N);
20300 EXPR SQRSLIST();
20400 BEGIN NEW I,VAL,TERM;
20500 FOR I←NSQ TO 1 BY -1
20600 DO (TERM←I) AND
20700 IF N*(I/N) NEQUAL I THEN
20800 VAL←TERM CONS VAL;
20900 RETURN VAL;
21000 END;
21100 EXPR STATLIN(LIN); MAST(IND(LIN));
21200 EXPR MASTVAL();
21300 BEGIN NEW I,VAL,TERM;
21400 FOR I←NLIN TO 1 BY -1
21500 DO PROG2(TERM←LINES[I] CONS MAST (I),
21600 VAL←TERM CONS VAL);
21700 RETURN VAL;
21800 END;
21900 EXPR SQRSVAL();
22000 BEGIN NEW I,VAL,TERM;
22100 FOR NEW I←NSQRS TO 1 BY -1
22200 DO PROG2(TERM←SQRSLIST()[I] CONS SQRS (I),
22300 VAL←TERM CONS VAL);
22400 RETURN VAL;
22500 END;
22600 EXPR INDSQ(SQ); SQ-(SQ/N);
22700 EXPR STATSQ(SQ); SQRS(INDSQ(SQ));
22800 EXPR SETMAST(LIN,PROP);MAST(IND(LIN))←PROP;
22900 EXPR SETSQ(SQ,SIDS);SQRS(INDSQ(SQ))←SIDS;
23000 EXPR LINESIN(SQ);< <SQ,1>,<SQ,2>,<SQ+N,1>,<SQ+1,2> >;
23100 EXPR TAKSAF();
23200 BEGIN NEW I,TAK;
23300 I←NLIN/2;
23400 BEG; IF MAST(I)='SA THEN TAK←LINES[I] ALSO UPDATE(TAK)
23500 ALSO RETURN TAK
23600 ELSE IF I=NLIN THEN GO CONT
23700 ELSE I←I+1;
23800 GO BEG;
23900 CONT;I←NLIN/2-1;
24000 BEG2; IF MAST(I)='SA THEN TAK←LINES[I] ALSO UPDATE(TAK)
24100 ALSO RETURN TAK
24200 ELSE IF I=1 THEN RETURN 'BLOCKED
24300 ELSE I←I-1;
24400 GO BEG2;
24500 END;
24600 EXPR OPLINS(SQ);
24700 BEGIN NEW VAL;
24800 FOR NEW I IN LINESIN(SQ)
24900 DO (IF STATLIN(I) NEQUAL 'TA
25000 THEN VAL←I CONS VAL);
25100 RETURN VAL;
25200 END;
25300 EXPR PRINLIN1(BEG,EN);
25400 BEGIN NEW I,TERM,VAL;
25500 VAL←"";
25600 FOR I←BEG TO EN-1 DO
25700 PROG2(IF STATLIN(<I,1>)='TA THEN
25800 IF I GEQUAL 10 THEN TERM←"." CAT I CAT "**"
25900 ELSE TERM←"." CAT I CAT "***"
26000 ELSE IF I GEQUAL 10 THEN TERM←"." CAT I CAT " "
26100 ELSE TERM←"." CAT I CAT " ",
26200 VAL←VAL CAT TERM);
26300 VAL←VAL CAT "." CAT EN;
26400 RETURN VAL;
26500 END;
26600 EXPR PRINLIN2(BEG,EN);
26700 BEGIN NEW I,TERM,VAL;
26800 VAL←"";
26900 FOR I←BEG TO EN DO
27000 PROG2(IF STATLIN(<I,2>)='TA THEN TERM←"* "
27100 ELSE TERM←" ",
27200 VAL←VAL CAT TERM);
27300 RETURN VAL;
27400 END;
27500 EXPR PRINTBD();
27600 BEGIN NEW I,BEG,EN;
27700 TERPRI NIL; TERPRI NIL;
27800 FOR I←1 TO N-1
27900 DO PROG2(BEG←N*(I-1)+1,
28000 EN←N*I,
28100 PRINTSTR PRINLIN1(BEG,EN),
28200 PRINTSTR PRINLIN2(BEG,EN),
28300 PRINTSTR PRINLIN2(BEG,EN));
28400 PRINTSTR PRINLIN1(NSQ-N+1,NSQ);
28500 TERPRI NIL;TERPRI NIL;
28600 END;
28700 EXPR GENBLOCK(OP1,OP2);
28800 BEGIN
28900 BLOCKS(BLOCKIND)←<OP1,OP2>;
29000 NSAF←NSAF-2;
29100 SETMAST(OP1,BLOCKIND);
29200 SETMAST(OP2,BLOCKIND);
29300 BLOCKVALS←(BLOCKIND CONS 1)CONS BLOCKVALS;
29400 BLOCKIND←BLOCKIND+1;
29500 END;
29600 EXPR STRETCHBL(NEWL,BLIND,CON);
29700 BEGIN
29800 IF CAR BLOCKS(BLIND)=CON THEN
29900 BLOCKS(BLIND)←NEWL CONS BLOCKS(BLIND)
30000 ELSE BLOCKS(BLIND)←BLOCKS(BLIND)@<NEWL>;
30100 SETMAST(NEWL,BLIND);
30200 NSAF←NSAF-1;
30300 BLOCKVALS←MERGEIN(BLOCKVALS,BLIND);
30400 END;
30500 EXPR MERGEIN(BVLS,BLIND);
30600 IF CAAR BVLS=BLIND THEN
30700 IF NULL CDR BVLS THEN <BLIND CONS CDAR BVLS+1>
30800 ELSE IF CDAR BVLS NEQUAL CDADR BVLS
30900 THEN (BLIND CONS CDAR BVLS+1) CONS CDR BVLS
31000 ELSE CADR BVLS CONS MERGEIN((CAR BVLS) CONS CDDR BVLS,
31100 BLIND)
31200 ELSE (CAR BVLS) CONS MERGEIN (CDR BVLS,BLIND);
31300 EXPR CONCAT(BLIND1,BLIND2,L1,L2);
31400 BEGIN NEW NEWBL,I,VAL;
31500 IF L1=CAR BLOCKS(BLIND1) AND L2=CAR BLOCKS(BLIND2) THEN
31600 NEWBL←REVERSE BLOCKS(BLIND1) @ BLOCKS(BLIND2)
31700 ELSE IF L1 = CAR BLOCKS(BLIND1)
31800 THEN NEWBL←BLOCKS(BLIND2) @ BLOCKS(BLIND1)
31900 ELSE IF L2=CAR BLOCKS(BLIND2)
32000 THEN NEWBL←BLOCKS(BLIND1) @ BLOCKS(BLIND2)
32100 ELSE NEWBL←BLOCKS(BLIND1) @ REVERSE BLOCKS(BLIND2);
32200 BLOCKS(BLOCKIND)←NEWBL;
32300 VAL←CDR ASSOC(BLIND1,BLOCKVALS)+CDR ASSOC(BLIND2,BLOCKVALS)
32400 +1;
32500 BLOCKVALS←DELETE(BLIND1,BLOCKVALS);
32600 BLOCKVALS←DELETE(BLIND2,BLOCKVALS);
32700 BLOCKVALS←INSERT(VAL,BLOCKVALS);
32800 FOR NEW I IN NEWBL DO SETMAST(I,BLOCKIND);
32900 BLOCKIND←BLOCKIND+1;
33000 END;
33100 EXPR DELETE(BLIND,BVLS);
33200 IF CAAR BVLS=BLIND THEN CDR BVLS
33300 ELSE CAR BVLS CONS DELETE(BLIND,CDR BVLS);
33400 EXPR INSERT(VAL,BVLS);
33500 IF NULL BVLS THEN <BLOCKIND CONS VAL>
33600 ELSE IF VAL LEQUAL CDAR BVLS THEN (BLOCKIND CONS VAL)
33700 CONS BVLS
33800 ELSE (CAR BVLS) CONS INSERT(VAL,CDR BVLS);
33900 EXPR INDEX(X,L);
34000 IF X=CAR L THEN 1
34100 ELSE ADD1 INDEX(X,CDR L);
34200 EXPR TAKBL(LIN,BLIND);
34300 % TAKBL HAS BEEN REWRITTEN RECURSIVELY IN ORDER THAT
34400 IT WORK PROPERLY IN THE CASE OF BLOCKS WHICH RE-FORM
34500 THEMSELVES IN THE PROCESS OF BEING TAKEN. FOR EXAMPLE,
34600 THIS CAN HAPPEN IN THE CASE OF P-SHAPED BLOCKS. THESE
34700 BLOCKS BEHAVE STRANGELY IN THAT THE ENTIRE BLOCK IS GIVEN
34800 AWAY IF A MOVE IS TAKEN FROM THE LOOP, BUT NOT IF A MOVE
34900 IS TAKEN FROM THE STEM. THE MACHINE STORES A P-SHAPED
35000 BLOCK AS TWO SMALLER BLOCKS, AND COMES TO RECOGNIZE THE
35100 FULL BLOCK IN THE PROCESS OF TAKING IT.%
35200 BEGIN NEW ST,I,VAL,BL,J,RVAL;
35300 BL←BLOCKS(BLIND);
35400 IF NULL TALIST THEN TALIST←<LIN>;
35500 VALUE←CDR ASSOC(BLIND,BLOCKVALS);
35600 I←INDEX(LIN,BL);
35700 VAL←SUFLIST(BL,I) @ REVERSE PRELIST(BL,I-1);
35800 START; J←CAR VAL;
35900 IF MEMBER(J,TALIST) THEN GO LOP;
36000 UPDATE(J);
36100 TALIST←TALIST @ <J>;
36200 IF BL NEQUAL BLOCKS(BLIND) THEN
36300 RETURN TAKBL(LIN,BLIND) ALSO GO BYE
36400 ELSE IF (ST←STATLIN(LIN)) NEQUAL 'TA THEN
36500 FOR J IN TALIST DO SETMAST(J,'TA)
36600 ALSO RETURN TAKBL(LIN,ST) ALSO GO BYE;
36700 LOP; VAL←CDR VAL;
36800 IF NOT NULL VAL THEN GO START;
36900 BLOCKVALS←DELETE(BLIND,BLOCKVALS);
37000 RVAL←CDR TALIST;
37100 TALIST←NIL;
37200 RETURN RVAL;
37300 BYE; END;
37400 EXPR TRANSL(LIN);
37500 IF CADR LIN= 1 THEN <CAR LIN, CAR LIN + 1>
37600 ELSE <CAR LIN, CAR LIN+N>;
37700 EXPR UPDATE(MOVE);
37800 BEGIN NEW O1,O2,S1,S2,SQ1,OPL;
37900 IF STATLIN(MOVE)='SA THEN NSAF←NSAF-1;
38000 NLEFT←SUB1 NLEFT;
38100 SETMAST (MOVE,'TA);
38200 FOR SQ1 IN NBRS(MOVE)
38300 DO BEGIN
38400 SETSQ (SQ1,STATSQ(SQ1)+1);
38500 IF STATSQ(SQ1)=2 THEN
38600 BEGIN
38700 OPL←OPLINS(SQ1);
38800 O1←CAR OPL;
38900 O2←CADR OPL;
39000 S1←STATLIN(O1);
39100 S2←STATLIN(O2);
39200 IF (NOT NUMBERP S1) AND (NOT NUMBERP S2)
39300 THEN GENBLOCK(O1,O2)
39400 ELSE IF (NUMBERP S1) AND (NUMBERP S2)
39500 THEN IF S1 NEQUAL S2 THEN CONCAT(S1,S2,O1,O2)
39600 ELSE CYCBLOCK(S1)
39700 ELSE IF NUMBERP S1 THEN STRETCHBL(O2,S1,O1)
39800 ELSE STRETCHBL(O1,S2,O2);
39900 END;
40000 END;
40100 END;
40200 EXPR GIVBL();
40300 BEGIN NEW MMOV,BL,ST;
40400 BL←CAAR BLOCKVALS;
40500 MMOV←CAR BLOCKS(BL);
40600 UPDATE(MMOV);
40700 IF(ST←STATLIN(MMOV)) NEQUAL 'TA
40800 THEN SETMAST(MMOV,'TA) ALSO BL←ST;
40900 LLIST←LOPOFF(MMOV,BLOCKS(BL));
41000 LVAL←CDR ASSOC(BL,BLOCKVALS);
41100 BLOCKVALS←DELETE(BL,BLOCKVALS);
41200 RETURN MMOV;
41300 END;
41400 EXPR LOPOFF(X,LIS);
41500 IF X=CAR LIS THEN CDR LIS
41600 ELSE(CAR LIS) CONS LOPOFF(X,CDR LIS);
41700 EXPR GRABIT(LIN);
41800 BEGIN NEW I,J;
41900 J←0;
42000 FOR I IN NBRS(LIN)
42100 DO IF STATSQ(I)=3 THEN J←J+1;
42200 RETURN J;
42300 END;
42400 EXPR TAKALIST(LST);
42500 BEGIN NEW PST;
42600 PST←"";
42700 IF NULL CDR LST THEN GO HERE
42800 ELSE FOR NEW K IN CDR LST
42900 DO PST←PST CAT ", " CAT TRANSL(K);
43000 HERE; PST←TRANSL(CAR LST) CAT PST;
43100 PRINTSTR("MACHINE TAKES " CAT PST);
43200 END;
43300 EXPR TAKABLOCK(LIN,BLIND);
43400 BEGIN NEW TLIS;
43500 TLIS←TAKBL(LIN,BLIND);
43600 IF NLEFT=0 THEN TAKALIST(TLIS)
43700 ELSE IF NSAF=0 THEN TAKALIST(TLIS @ <GIVBL()>)
43800 ELSE TAKALIST(TLIS @ <TAKSAF()>);
43900 MSCORE←MSCORE+VALUE;
44000 END;
44100 EXPR TAKASAFE(); TAKALIST(<TAKSAF()>);
44200 EXPR GIVEABLOCK(); TAKALIST(<GIVBL()>);
44300 EXPR HOOK(LLIS);
44400 IF GRABIT(CAR LLIS) THEN 1
44500 ELSE ADD1 HOOK(CDR LLIS);
44600 EXPR CYCBLOCK(BLIND); BLOCKVALS←MERGEIN(BLOCKVALS,BLIND);
44700 END.